(defpackage :basic-fill-callback
  (:nicknames :bfc)
  (:use :cl)
  (:export :make-callback))

(in-package :basic-fill-callback)

(defstruct (callback-data (:conc-name cd-))
  kp-parent
  input-must-be-correct
  no-collapse
  input-collapsed
  all-inputs-collapsed
  add-to-input
  enter
  leave)

(defgeneric callback (diagram event data))

(defun delete-inputs (kp-parent)
  (gwee:delete-views-if (lambda (view)
                          (typep view 'kp:tiny-keypad))
                        kp-parent))

(defun collapse-node (diagram node data)
  (when (and (typep node 'd:input-argument)
             (d:quantity node)
             (d:valid-input-p node (u:string2 (d:quantity node)))
             (or (not (cd-input-must-be-correct data))
                 (string= (d:quantity node) (print (u:string2 (d:answer node))))))
    (let ((correct (string= (d:quantity node) (print (u:string2 (d:answer node))))))
      (o:collapse-input-argument node)
      (when (cd-input-collapsed data)
        (funcall (cd-input-collapsed data) diagram node correct)))
    (unless (d:find-if-on-tree (constantly t)
                               (d:root diagram)
                               :only-type 'd:input-argument)
      (when (cd-all-inputs-collapsed data)
        (funcall (cd-all-inputs-collapsed data) diagram)))))

(defun kp-callback (diagram kp string data)
  (symbol-macrolet ((val (d:quantity (kp:target kp))))
    (case string
      (:backspace
       (when (plusp (length val))
         (setf val (subseq val 0 (1- (length val))))
         (when (string= val "")
           (setf val nil))))
      (t
       (setf val (concatenate 'string val string))))
    (when (cd-add-to-input data)
      (funcall (cd-add-to-input data) diagram (kp:target kp) string))
    (d:update-diagram-view diagram)))

(defun close-keypad (diagram kp data)
  (when (cd-leave data)
    (funcall (cd-leave data) diagram (kp:target kp)))
  (setf (d:highlighted (kp:target kp)) nil)
  (d:update-diagram-view diagram)
  (unless (cd-no-collapse data)
    (collapse-node diagram (kp:target kp) data))
  (delete-inputs (cd-kp-parent data)))

(defun open-keypad-for (diagram node data)
  (let ((input (make-instance 'kp:tiny-keypad :x 0 :y 0
                              :parent (cd-kp-parent data)
                              :target node
                              :key-callback (lambda (kp s)
                                              (kp-callback diagram kp s data)))))
    (gwee:add-hook (gwee:leave-hook input) (lambda (kp x y s)
                                             (declare (ignore s))
                                             (setf x (gwee:top-to-view-x diagram x)
                                                   y (gwee:top-to-view-y diagram y))
                                             (unless (geom:insidep (kp:target kp) x y)
                                               (close-keypad diagram kp data))))
    (gwee:sync-views (cd-kp-parent data))
    (let ((xrel (- (gwee:view-to-top-x diagram 0)
                   (gwee:view-to-top-x (cd-kp-parent data) 0)))
          (yrel (- (gwee:view-to-top-y diagram 0)
                   (gwee:view-to-top-y (cd-kp-parent data) 0))))
      (setf (d:highlighted node) t
            (gwee:view-x input) (+ xrel
                                   (- (geom:centerx node)
                                      (u:half (gwee:view-width input))))
            (gwee:view-y input) (ecase (d:input-location node)
                                  (:above (+ yrel
                                             (- (geom:y node) (gwee:view-height input)
                                                (- (gwee:margin-bottom (slot-value input 'kp::default))))))
                                  (:below (+ yrel
                                             (- (geom:bottom node)
                                                (gwee:margin-bottom (slot-value input 'kp::default))))))
            (gwee:view-needs-update-p diagram) t)
      (when (cd-enter data)
        (funcall (cd-enter data) diagram (kp:target input)))
      input)))

(defun find-keypad (kp-parent)
  (find-if (lambda (v) (typep v 'kp:tiny-keypad))
           (gwee:view-subviews kp-parent)))

(defmethod callback (diagram (event e:motion-event) data)
  (let ((kp (find-keypad (cd-kp-parent data))))
    (when (and kp
               (u:neq (kp:target kp) (e:enter event)))
      (close-keypad diagram kp data))
    (when (typep (e:enter event) 'd:input-argument)
      (open-keypad-for diagram (e:enter event) data))))

(defmethod callback (diagram (event e:event) data)
  ;; swallow any other events
  )

(defun make-callback (kp-parent &key leave enter (input-must-be-correct t) input-collapsed all-inputs-collapsed add-to-input no-collapse)
  "KP-PARENT is the view the keypad should be a subview of."
  (let ((data (make-callback-data
               :kp-parent kp-parent
               :leave leave
               :enter enter
               :input-must-be-correct input-must-be-correct
               :input-collapsed input-collapsed
               :all-inputs-collapsed all-inputs-collapsed
               :add-to-input add-to-input
               :no-collapse no-collapse)))
    (values
     (lambda (diagram event)
       (callback diagram event data))
     data)))
